DWPASHL ;PICASSO/JOLLIS - PREFINITI ADMIN SHELL;9/11/10;src/pash/PASHELL.m
;;3.0;PASH;9/12/10;1
 N DCSCR,EMAIL,PWD,KSTR
 S DCSCR=1
 S EMAIL=""
 S PWD=""
 S KSTR=""
PWRETR
 I ^DWPREF("FIRSTRUN")=0 D
 .W #,"Prefiniti 3.0",!
 .W " Copyright (C) 2010 Coherent Logic Development LLC",!,!
 .W "This program is provided under the terms of the GNU Affero",!
 .W "General Public License v3. See the file COPYING in the root",!
 .W "directory of your Prefiniti installation for more details.",!,!,!
 .W "E-MAIL ADDRESS:   "
 .R EMAIL
 .U $P:(NOECHO)
 .W !,"PASSWORD:         "
 .R PWD
 .U $P:(ECHO)
 .I $$LOGIN^DWSCAUTH(EMAIL,PWD,"DIRECT")=0 D
 ..W !,"INCORRECT E-MAIL ADDRESS OR PASSWORD.",!
 ..D PAUSE("PLEASE TRY AGAIN.")
 ..G PWRETR
 .S KSTR="DIRECT:"_EMAIL
 D RESETSCR

COPYSCR 
 D LOCATE^DWKRRNSI(0,3)
 W "Prefiniti 3.0 Shell",!
 W " Copyright (C) 2010 Coherent Logic Development LLC",!,!
 W "This program is provided under the terms of the GNU Affero",!
 W "General Public License v3. See the file COPYING in the root",!
 W "directory of your Prefiniti installation for more details."
 S DCSCR=0
 HANG 2
 Q
 
MKSCR
 D RESET^DWKRRNSI()
 U $P:(NOWRAP:NOCONVERT)
 D HDRBAR^DWKRRNSI("WHITE","BLUE",TW)
 D COLOR^DWKRRNSI("WHITE","BLUE")
 S HDRSTR=""
 I EMAIL'="" D
 .S HDRSTR=HDRSTR_EMAIL
 .S HDRSTR=HDRSTR_"  Device: "_^DWPRVDOM(KSTR,"DEVICE")
 .I ^DWPRVDOM(KSTR,"VISTADUZ")'="" D
 ..S HDRSTR=HDRSTR_"  VistA:  "
 ..S HDRSTR=HDRSTR_^DWPRVDOM(KSTR,"VISTANAME")
 ..S HDRSTR=HDRSTR_"   "_^DWPRVDOM(KSTR,"VISTANICK")
 D WRITEAT^DWKRRNSI(0,0,$C(27)_"[1mPrefiniti 3.0   "_HDRSTR_$C(27)_"[0m")
 D LOCATE^DWKRRNSI(0,TH-2)
 D COLOR^DWKRRNSI("WHITE","BLACK")
 F I=1:1:TW W "-"
 D COLOR^DWKRRNSI("CYAN","BLACK")
 S INN=^DWPREF("SITENAME")
 S FRAME=$P($P(INN,"F",2),"I",1)
 S INSTANCE=+$P(INN,"I",2)
 S MODE=$E(INN,$L(INN),$L(INN))
 D WRITEAT^DWKRRNSI(0,TH,"JOB "_$J_" FRAME "_FRAME_" INSTANCE "_INSTANCE_" MODE "_MODE_"  ROOT "_$$ROOTNODE^DWORREC()_"   MODULES:  "_$$MODULES^DWKRMODI)
 D COLOR^DWKRRNSI("WHITE","BLACK")
 Q

RESETSCR
 S CMD=""
 S TW=$$TRMCOLS^DWKRRNSI()
 S TH=$$TRMLINES^DWKRRNSI()
 D MKSCR
 I DCSCR=1 D COPYSCR
 D MKSCR
 D READLOOP

READLOOP
 D LOCATE^DWKRRNSI(0,40)
 I ^DWPREF("FIRSTRUN")=1 D FIRSTRUN
 D COLOR^DWKRRNSI("GREEN","BLACK")
 D WRITEAT^DWKRRNSI(0,TH-1,$C(27)_"[1mPREFINITI:"_^DWPREF("SITENAME")_">  "_$C(27)_"[0m")
 D COLOR^DWKRRNSI("WHITE","BLACK")
 U $P:(NOWRAP:CONVERT) R CMD
 D LOCATE^DWKRRNSI(15,0)
 U $P:(NOWRAP:NOCONVERT)
 D PASHCMD(CMD)
 D RESETSCR

FIRSTRUN
 D LOCATE^DWKRRNSI(0,3)
 W "FIRST RUN:  PRESS ENTER TO CONFIGURE THE FIRST USER FOR THIS INSTANCE",!
 R X
 S OID=$$RNDRADD("USER","N",1,0)
 D PAUSE("FIRST USER CREATED AT NODE "_OID)
 S ^DWPREF("FIRSTRUN")=0
 D RESETSCR
 Q

PASHCMD(COMMAND)
 I COMMAND="" GOTO ENDCMD
 I $G(^DWPCMD(COMMAND))'="" X ^DWPCMD(COMMAND) D RESETSCR
 D CCOMPLET(COMMAND)
ENDCMD
 Q

CCOMPLET(CMD)
 N OPTIONS
 N OPTIND
 N PT
 S OPTIND=0
 S PT=""
 F I=0:0 S PT=$O(^DWPCMD(PT)) Q:PT=""  D
 .I PT[CMD D
 ..S OPTIND=OPTIND+1
 ..S OPTIONS(OPTIND)=PT
 I OPTIND=0 D 
 .D COLOR^DWKRRNSI("RED","BLACK")
 .D WRITEAT^DWKRRNSI(0,5,"No matches for "_CMD_". Press ENTER to continue.")
 .D COLOR^DWKRRNSI("WHITE","BLACK")
 .R X
 .D RESETSCR
 D LOCATE^DWKRRNSI(0,3)
 W "DID YOU MEAN:",!
 F I=1:1:OPTIND D
 .W "  ",I,") ",OPTIONS(I),!
SELOPT
 W !,"SELECT AN OPTION [ENTER FOR NONE]:  "
 R OPT
 I (OPT>0)&(OPT<(OPTIND+1)) X ^DWPCMD(OPTIONS(OPT)) Q
 D RESETSCR
 Q

QRYORMS
 W !,"QUERY ORMS:",!
 W "  QUERY STRING? "
 U $P:(NOCONVERT)
 R QS
 S RSNAME=$$BLDQRY^DWORRSET(QS)
 S RS=""
 S STR=""
 S MC=0
 S FC=$L(^DWRSMETA(RSNAME,"FIELDNAMES"),",")+1
 S TABSTOPS=(TW-5)/FC
 W !,!,"QUERY RESULTS   BLOCKTYPE ",^DWRSMETA(RSNAME,"LBLOCKTYPE"),"   RECORDSET ",RSNAME,!
 W $J("REVISION",TABSTOPS)
 F I=1:1:FC-1 D
 .S FIELDNAM=$P(^DWRSMETA(RSNAME,"FIELDNAMES"),",",I)
 .W $J(FIELDNAM,TABSTOPS)
 W !
 F I=0:0 S RS=$O(^DWRSET(RSNAME,RS)) Q:RS=""  D
 .S MC=MC+1
 .W $J(^DWRSET(RSNAME,RS,"REVN"),TABSTOPS)
 .F I=1:1:FC-1 D
 ..S FVAL=$P(^DWRSET(RSNAME,RS,"FIELDS"),"^~",I)
 ..I ^DWRSMETA(RSNAME,"LBLOCKTYPE")="TIMESTAMPS" S FVAL=$ZD(FVAL,"YEARMMDD.12:60AM")
 ..I $L(FVAL)>TABSTOPS S FVAL=$E(FVAL,1,TABSTOPS-5)_"..."
 ..W $J(FVAL,TABSTOPS)
 .W !
 W !,!,MC," RESULTS IN SET.",!,!
 D PAUSE("")
 Q


LISTCMD
 W !,"COMMANDS:",!
 N CM S CM=""
 F I=0:0 S CM=$O(^DWPCMD(CM)) Q:CM=""  W "  ",CM,!
 D PAUSE("")
 Q

DESCCLS
 U $P:(CONVERT)
 W !,"DESCRIBE CLASS:",!
 W "  CLASS NAME? "
 R CLASN
 U $P:(NOCONVERT)
 W !
 S CLASLST=$$LISTFLDS^DWORCLAS(CLASN,"N",CLASN)
 S FC=$L(CLASLST,",")
 S I=""
 F I=1:1:FC W $P(CLASLST,",",I),!
 D PAUSE("")
 Q

EDITMOD
 D MKSCR
 D LOCATE^DWKRRNSI(0,3)
 W "EDIT MODULE:",!
 W !,"   PACKAGE? "
 R PKG
 U $P:(NOWRAP:CONVERT)
 W !,"   MODULE?  "
 R MOD
 U $P:(NOWRAP:NOCONVERT)
 ZSYSTEM "emacs ${PREFINITI_ROOT}/src/"_PKG_"/"_MOD_".m"
 Q

SYSSHELL
 D RESET^DWKRRNSI()
 W "Type ""exit"" to return to the Prefiniti Shell",!,!
 ZSYSTEM
 Q

INPTCLS
 D MKSCR
 S LDEL="#"
 S PDEL=":"
 D LOCATE^DWKRRNSI(0,4)
 W "CLASS INPUT:",!
 W "  CLASS TO INPUT? "
 U $P:(NOWRAP:CONVERT)
 R CLASNAME
 W !,"  REVISION? [""N"" FOR NEWEST] "
 R REVN
 S OID=$$RNDRADD(CLASNAME,REVN,1,0)
 D PAUSE("ORMS:  NEW INSTANCE OF "_CLASNAME_" CREATED AT NODE "_OID)
 S ^DWPREF("FIRSTRUN")=0
 Q

;;PDOC
;;SUMMARY Render an add class instance form
;;DEFFNC
RNDRADD(CLASNAME,REVN,SHHDR,STUFFPK)
;;ARG 1 CLASNAME The class for which to render this form
;;ARG 2 REVN The revision number of the class, N for most recent
;;ARG 3 SHHDR Should be 1 to show header, 0 to hide header
;;ARG 4 STUFFPK The value with which to fill the PK field, 0 for none
;;PDOC/
 N LDEL,PDEL,REVV,CLASDEFN,HDRLINE,CLASLABL,CSSCLASS,PK,FLDCNT,OID,IX
 N CURFLD,RECORDKEY,TYPEFLD,PRITYPE,SUBTYPE,ATTRS,RULE,DEFAULT,LABEL
 N IX,REQUIRED
 S LDEL="#"
 S PDEL=":"
 U $P:(NOWRAP:NOCONVERT)
 S REVV=REVN
 S DEFNOID=$$RETRIEVE^DWORCLAS(CLASNAME)
 I REVN="N" S REVV=$$NEWEST^DWORREC(DEFNOID,"CLASDEFN")
 S CLASDEFN=$$INPUT^DWORREC(DEFNOID,"CLASDEFN",REVV)
 S HDRLINE=$P(CLASDEFN,LDEL,1)
 S CLASLABL=$P(HDRLINE,PDEL,3)
 S CSSCLASS=$P(HDRLINE,PDEL,2)
 S PK=$P(HDRLINE,PDEL,4)
 I SHHDR=1 D
 .D MKSCR
 .D LOCATE^DWKRRNSI(0,2)
 .W !,"INPUT NEW ",CLASNAME,"  PRIMARY KEY:  ",PK,"  "
 .W "[*] INDICATES REQUIRED FIELD",!
 S FLDCNT=+$L(CLASDEFN,LDEL)
 S OID=$$CREATE^DWORREC($$ROOTNODE^DWORREC(),CLASNAME,CLASNAME,"CREATOR","PASH")
 S IX=0
 F IX=2:1:FLDCNT D
 .S CURFLD=$P(CLASDEFN,LDEL,IX)
 .S RECORDKEY=$P(CURFLD,PDEL,1)
 .S TYPEFLD=$P(CURFLD,PDEL,2)
 .S PRITYPE=$P(TYPEFLD,",",1)
 .S SUBTYPE=$P(TYPEFLD,",",2)
 .I PRITYPE="CLASPTR" S CPREV=$P(TYPEFLD,",",3)
 .S ATTRS=$P(CURFLD,PDEL,3)
 .S RULE=$P(CURFLD,PDEL,4)
 .S DEFAULT=$P(CURFLD,PDEL,5)
 .S LABEL=$P(CURFLD,PDEL,6)
 .S REQUIRED=0
 .I ATTRS["REQUIRED" S REQUIRED=1
 .I PRITYPE="TEXT" D TXTFIELD(OID,RECORDKEY,PK,RULE,DEFAULT,SUBTYPE,REQUIRED,LABEL,STUFFPK)
 .I PRITYPE="PASSWORD" D PWFIELD(OID,RECORDKEY,PK,RULE,DEFAULT,SUBTYPE,REQUIRED,LABEL)
 .I PRITYPE="CLASPTR" D CPFIELD(OID,RECORDKEY,CPREV,PK,RULE,DEFAULT,SUBTYPE,REQUIRED,LABEL)
 .S TMP=0
 D COLOR^DWKRRNSI("WHITE","BLACK")
 Q OID 

TXTFIELD(OID,KEY,PK,RULE,DEFAULT,SUBTYPE,REQ,LABEL,SPK)
TFRETR
 I (SPK=1)&(KEY=PK) S FVAL=$$GETNEXT^DWKRFUID()_LABEL GOTO TFWR
 W !
 I REQ=1 W "[*]  "
 I REQ=0 W "     "
 W LABEL
 I DEFAULT'="" W " [ENTER FOR DEFAULT:  """,DEFAULT,"""]"
 W "?  "
 I SUBTYPE="SINGLE" R FVAL
 I SUBTYPE="MULTI" S FVAL=$$MLTILINE^DWKRRNSI()
 I FVAL="" S FVAL=DEFAULT
 I (FVAL="")&(REQ=1) D 
 .W "THIS FIELD IS REQUIRED! TRY AGAIN.",! D TFRETR
TFWR
 D APPEND^DWORREC(OID,KEY,FVAL)
 Q

PWFIELD(OID,KEY,PK,RULE,DEFAULT,SUBTYPE,REQ,LABEL)
PFRETR
 W !
 I REQ=1 W "[*]  "
 I REQ=0 W "     "
 W LABEL,"? [WILL NOT BE SHOWN] "
 U $P:(NOWRAP:NOECHO)
 R FVAL
 W !,"     ",LABEL,"? [RE-ENTER TO CONFIRM] "
 R FVALC
 I FVAL'=FVALC D
 .W !,"PASSWORD AND CONFIRMATION DO NOT MATCH! TRY AGAIN.",! D PFRETR
 U $P:(NOWRAP:ECHO)
 I (FVAL="")&(REQ=1) D
 .W "THIS FIELD IS REQUIRED! TRY AGAIN.",! D PFRETR
 D APPEND^DWORREC(OID,KEY,FVAL)
 Q

CPFIELD(OID,KEY,REV,PK,RULE,DEFAULT,SUBTYPE,REQ,LABEL)
 W !,!
 I REQ=1 W "[*]  "
 I REQ=0 W "     "
 W LABEL,":",!
 S FVAL="//CLASPTR:"_$$RNDRADD(SUBTYPE,REV,0,1)_","_REV
 D APPEND^DWORREC(OID,KEY,FVAL)
 Q

SHOHOOKS
 S HDR1="                  ACTIVE HOOKS ON "_^DWPREF("SITENAME")
 S HDR2=$J("MODULE",10)_" "_$J("CLASS",10)_" "_$J("C",2)_" "_$J("R",2)_" "_$J("D",2)_" "_$J("CALLBACK",20)
 S HDR3=$J("------",10)_" "_$J("-----",10)_" "_$J("-",2)_" "_$J("-",2)_" "_$J("-",2)_" "_$J("--------",20)
 W !!,HDR1,!,!,HDR2,!,HDR3,!
 S (C0,C1,C2)=""
 F I=0:0 S C0=$O(^DWHOOKS(C0)) Q:C0=""  D
 .F I=0:0 S C1=$O(^DWHOOKS(C0,C1)) Q:C1=""  D
 ..F I=0:0 S C2=$O(^DWHOOKS(C0,C1,C2)) Q:C2=""  D
 ...S MODULE=C0 S CLASS=C1
 ...S CALLBACK=^DWHOOKS(C0,C1,C2)
 ...S EM=^DWHOOKS(C0,C1,C2,"EVNTMASK")
 ...S (CREATE,REVISE,DELETE)="-"
 ...I $E(EM,1)=1 S CREATE="*"
 ...I $E(EM,2)=1 S REVISE="*"
 ...I $E(EM,3)=1 S DELETE="*"
 ...S HS=$J(MODULE,10)_" "_$J(CLASS,10)_" "_$J(CREATE,2)_" "_$J(REVISE,2)_" "_$J(DELETE,2)_" "_$J(CALLBACK,20)
 ...W HS,!
 D PAUSE("")
 Q

SHOUSERS
 N TABSTOPS,CU,HDRSTR,FLDSTR
 S TABSTOPS=TW/5
 S HDRSTR=$J("USER",TABSTOPS)_$J("SESSION TYPE",TABSTOPS)_$J("DEVICE",TABSTOPS)_$J("JOB",TABSTOPS)_$J("ACTIVE SINCE",TABSTOPS)
 W !,"SHOW USERS:",!,HDRSTR,!
 S CU=""
 F I=0:0 S CU=$O(^DWPRVDOM(CU)) Q:CU=""  D
 .I ^DWPRVDOM(CU,"OUTTIME")="" D
 ..S FLDSTR=""
 ..S FLDSTR=$J($P(CU,":",2),TABSTOPS)_$J($P(CU,":",1),TABSTOPS)
 ..S FLDSTR=FLDSTR_$J(^DWPRVDOM(CU,"DEVICE"),TABSTOPS)_$J(^DWPRVDOM(CU,"JOB"),TABSTOPS)
 ..S FLDSTR=FLDSTR_$J($ZD(^DWPRVDOM(CU,"INTIME"),"YEARMMDD.12:60AM"),TABSTOPS)
 ..W FLDSTR,!
 D PAUSE("")
 Q

SHOOSTAT
 W !,"OBJECT RECORD MANAGEMENT SYSTEM - STATISTICS",!,!
 W "  Transactions",!
 W "  ------------",!
 W "    ADD RECORD:        ",^DWORSTAT("ADD"),!
 W "    REVISE RECORD:     ",^DWORSTAT("REVISE"),!
 W "    APPEND RECORD:     ",^DWORSTAT("APPEND"),!
 W "    READ RECORD:       ",^DWORSTAT("READS"),!,!
 W "  Primary Data Blocks",!
 W "  -------------------",!
 W "    PDB BYTES READ:    ",^DWORSTAT("READBYTES"),!
 W "    PDB BYTES WRITTEN: ",^DWORSTAT("PDBBYTES"),!,!
 W "  Other Statistics",!
 W "  ----------------",!
 W "    KEY BYTES WRITTEN: ",^DWORSTAT("KEYBYTES"),!
 W "    OID BYTES WRITTEN: ",^DWORSTAT("OIDBYTES"),!
 W "    HOOKS EXECUTED:    ",^DWORSTAT("HOOKSRUN"),!,!
 D PAUSE("")
 Q  



SHOMODS
 Q

FETCHRS
 Q

QRYLOGS
 Q

CREATCLS
 W !,"ORMS - CREATE CLASS",!,!
 W "NAME? "
 R NAME
 W !,"DEFN? "
 S DEFN=$$MLTILINE^DWKRRNSI
 S CID=$$CREATE^DWORCLAS(NAME,DEFN)
 W !,"PK? "
 R PK
 D SETPK^DWORCLAS(NAME,PK)
 W !,"ORMS:  CLASS ",NAME," STORED IN RECORD ID ",CID,!
 Q

UPDTCLS
 W !,"ORMS - UPDATE CLASS",!,!
 W "NAME? "
 R NAME
 W !,"DEFN? "
 R DEFN
 S CID=$$RETRIEVE^DWORCLAS(NAME)
 D UPDATE^DWORCLAS(CID,DEFN)
 S REV=$$REVISION^DWORCLAS(CID)
 W !,"ORMS:  DEFINITION FOR CLASS ",NAME," HAS BEEN UPDATED",!
 W "ORMS:  CLASS IS NOW AT REVISION ",REV,!
 Q
 

CREATREC
 W !,"ORMS - CREATE RECORD",!,!
 W "PARENT? "
 R PAR
 W !,"CLASS? "
 R CLASS
 W !,"NAME? "
 R NAME
 W !,"KEY? "
 R KEY
 W !,"DATA? "
 R DATA
 W !,"ORMS:  ALLOCATED RECORD ",$$CREATE^DWORREC(PAR,CLASS,NAME,KEY,DATA)," WITH ",$L(DATA)," CHARACTERS OF NEW DATA",!,!
 Q

UPDTREC
 W !,"ORMS - UPDATE RECORD",!,!
 W "ID? "
 R OID
 W !,"KEY? "
 R KEY
 W !,"NEW DATA? "
 R DATA
 D OUTPUT^DWORREC(OID,KEY,DATA)
 W !,"ORMS:  UPDATED RECORD ",OID," WITH ",$L(DATA)," CHARACTERS OF NEW DATA",!
 W "ORMS:  RECORD ",OID,"(",KEY,") IS NOW AT REVISION ",$$NEWEST^DWORREC(OID,KEY),!,!
 Q

APNDREC
 W !,"ORMS - APPEND RECORD",!,!
 W "ID? "
 R OID
 W !,"NEW KEY? "
 R KEY
 W !,"NEW DATA? "
 R DATA
 D APPEND^DWORREC(OID,KEY,DATA)
 W !,"ORMS:  APPENDED RECORD ",OID," WITH ",$L(DATA)," CHARACTERS OF NEW DATA",!
 Q

VIEWREC
 W !,"ORMS - VIEW RECORD",!,!
 W "ID? "
 R OID
 W !,"KEY? "
 R KEY
 W !,"REVISION (DEFAULT:  NEWEST)? "
 R REV
 I REV="" S TREV=$$NEWEST^DWORREC(OID,KEY)
 I REV'="" S TREV=REV
 W !,"ORMS:  RECORD ",OID,"(",KEY,";",TREV,")='"
 W $$INPUT^DWORREC(OID,KEY,TREV),"'",!,!
 Q

PAUSE(MESSAGE)
 N X
 W !,MESSAGE,!
 W "Press ENTER to continue . . ."
 R X
 Q

SHELQUIT
 D RESET^DWKRRNSI()
 D LOGOUT^DWSCAUTH("DIRECT","")
 HALT
Q 